(load "dl-s.lisp")
(defun dl-pr (dl &optional depth direction)
  (if (null depth)
      (format t "#<DL ~a>~%" (dl->list dl))
      (if (null direction)
	      (progn (if (not (integerp depth)) (setf depth 0))
		     (format t "#<DL ~a>~%" (dl->list-n dl depth)))
	      (if (and (alpha-char-p direction) (integerp depth))
		  (cond ((char= direction #\n) (format t "#<Dln->* ~a>~%" (dl->list-n dl depth)))
			((char= direction #\p) (format t "#<DL<-p* ~a>~%" (dl-str-reverse (dl->list-p dl depth))))
			((char= direction #\a)
			 (let ((tmp-str nil)(n 0))
			   (setf tmp-str (dl-str-reverse (dl->list-p dl depth)))
			   (setf tmp-str (concatenate 'string tmp-str (dl->list-n dl depth)))
			   (format t "#<DL[~a] ~a>~%" (cur-dl dl) tmp-str)))
			(T (format t "#<DL ~a>~%" (dl->list-n dl depth))))
		  (format t "#<DL 函数调用参数异常，请检查后重新运行>~%")))))

(defun string-reverse(str)
  (let* ((len (length str))(s (make-string len)))
    (dotimes (i len)
      (setf (char s i) (char str (- len i 1))))
    s))
(defun dl-str-reverse(str)
  (let* ((len (length str))(s (make-string len))(tmp-str (make-string len))(flag nil)(b 0)(k 0))
    (dotimes (i len)
      (let ((c (char str i)))
	(case c
	  ((#\( #\) #\space #\.)
	   (progn (setf (char s (- len i 1)) c)
		  (if (eql flag T)
		      (progn (setf (subseq s (- len b k) (- len b)) (subseq tmp-str 0 k))
			     (setf flag nil)
			     (setf b 0)
			     (setf k 0)))))
	  (T (progn
	       (if (null flag) (setf b i))
	       (setf (char tmp-str k) c)
	       (setf k (1+ k))
	       (setf flag T))))))
    s))
	     
;;(defun dl->list(lst)
;;  (if (dl-p lst)
;;      (cons (dl-data lst)(dl->list dl-next))
;;      lst))

(defun dl->list-n (dl n)
  (let ((tmp-dl dl)(str "")(tmp-str ""))
    (if (null (dl-prev dl)) (setf str "")(setf str "..."))
    (if (= n 0)
	(setf str (concatenate 'string str (dl-get-symbol tmp-dl)))
	(loop for i from 0 to n  do
		    (if (null tmp-dl)
			(return-from dl->list-n (concatenate 'string str ")"))
			(progn (multiple-value-setq (tmp-str tmp-dl) (dl-get-symbol tmp-dl))
			      ;; (format t "{~a}{~a}<~a>|" tmp-str tmp-dl i)
			       (setf str (concatenate 'string str tmp-str " "))
			       (if (not (null tmp-dl))
				   (setf tmp-dl (dl-next tmp-dl)))))))
    (if (null tmp-dl)
		   (concatenate 'string str ")")
		   (concatenate 'string str "..."))))
       
(defun dl->list-p (dl n)
  (let ((tmp-dl dl)(str "")(tmp-str ""))
    (if (null (dl-next dl)) (setf str ")")(setf str "..."))
    (if (= n 0)
	(setf str (concatenate 'string str (dl-get-symbol tmp-dl)))
	(loop for i from 0 to n  do
		    (if (null tmp-dl)
			(return-from dl->list-p (concatenate 'string str "("))
			(progn (if (dl-p (dl-data tmp-dl))
				   (setf str (concatenate 'string str "("))
				   (setf str (concatenate 'string str (format nil "~a " (dl-data tmp-dl)))))
			       	 
			      
			       (if (not (null tmp-dl))
				   (setf tmp-dl (dl-prev tmp-dl)))))))
    (if (null tmp-dl)
		   (concatenate 'string str "(")
		   (concatenate 'string str "..."))))		     
	   
(defun dl-get-symbol(dl)
  (let ((str ""))
	(if (dl-p (dl-data dl))
	    (loop while (dl-p (dl-data dl)) do
		 (setf str (concatenate 'string str "("))
		 (setf dl (dl-data dl))))	
	(values (concatenate 'string str (format nil "~a" (dl-data dl))) dl)))

	    
(defun dl-go-prev(dl n)
  (if (= n 0)
      (values dl n)
      (progn (dotimes (i n)
	       (if (null (dl-prev dl))
	        (return-from dl-go-prev (values dl i))
	        (setf dl (dl-prev dl))))
	     (values dl n))))
(defun dl-go-next(dl n)
  (if (= n 0)
      (values dl n)
      (progn (dotimes (i n)
	       (if (null (dl-next dl))
	        (return-from dl-go-next (values dl i))
	        (setf dl (dl-next dl))))
	     (values dl n))))
(defun dl-go-data(dl n)
  (if (= n 0)
      (values dl n)
      (let ((tmp-dl dl)(i 0))
	(loop while (and (not (null dl)) (not (= n i))) do
	     (if (dl-p dl)
		 (progn (if (dl-p (dl-data dl))
			    (progn (setf i (1+ i))
				   (setf tmp-dl (dl-data dl))))
			(setf dl (dl-next dl)))
		 (return-from dl-go-data (values tmp-dl i))))
	(values tmp-dl i))))

(defun dl-length(dl)
  (if (null dl)
      0
      (1+ (dl-length (dl-next dl)))))
(defun dl-element(dl)
  (if (null dl)
      0
      (if (dl-p (dl-data dl))
	  (+ (dl-element (dl-data dl)) (dl-element (dl-next dl)))
	  (1+ (dl-element (dl-next dl))))))
(defun dl-search(x dl)
  (if (null dl)
      nil
      (if (dl-p (dl-data dl))
	  (progn (setf tmp-dl  (dl-search x (dl-data dl)))
		 (if (null tmp-dl)
		     (dl-search x (dl-next dl))
		     tmp-dl))
	  (if (eql x (dl-data dl))
	      dl
	      (dl-search x (dl-next dl))))))
(defun dl-search-n(x dl n)
  (dl-s x dl n))
			    
	      
(defun cur-dl(dl)
  (if (dl-p (dl-data dl))
      (string #\^)
      (dl-data dl)))
(defun dl-read(e dl)
  (if (null e)
      nil
      (if (atom e)
	  e
	  (dl-insert (dl-read (car e) dl) (dl-read (cdr e) dl)))))
(defun dl-eq(dl1 dl2)
  (if (eq dl1 dl2)
      T
      (if (and (dl-p dl1) (dl-p dl2))
	  (cond ((and (dl-p (dl-data dl1)) (dl-p (dl-data dl2)))
		 (and (dl-eq (dl-data dl1) (dl-data dl2)) (dl-eq (dl-next dl1) (dl-next dl2))))
		((and (not (dl-p (dl-data dl1))) (not (dl-p (dl-data dl2))))
		 (and (eql (dl-data dl1) (dl-data dl2)) (dl-eq (dl-next dl1) (dl-next dl2))))
		(T nil))
	  nil)))

(defun dl-head(dl)
  (if (null dl)
      nil
      (if (dl-p dl)
	  (let ((tmp-dl nil))
	    (loop while (dl-p dl) do
		 (setf tmp-dl dl)
		 (setf dl (dl-prev dl)))
		 tmp-dl)
	  nil)))
(defun dl-tail(dl)
  (if (null dl)
      nil
      (if (dl-p dl)
	  (let ((tmp-dl nil))
	    (loop while (dl-p dl) do
		 (setf tmp-dl dl)
		 (setf dl (dl-next dl)))
		 tmp-dl)
	  nil)))
(defun dl-merge(dl1 dl2)
  (if (null dl1)
      (if (null dl2)
	  nil
	  dl2)
      (progn (setf (dl-next dl1) dl2)
	     (setf (dl-prev dl2) dl1)
	     dl1)))
      
(defun dl-main(dl)
  (dotimes (i (dl-length dl)) (format t "~a->" (cur-dl dl))(setf dl (dl-next dl))))
(defun dl-layer-head(dl)
  (if (null dl)
      nil
      (if (dl-p dl)
	  (let ((tmp-dl nil))
	    (loop while (dl-p dl) do
		 (if (dl-p (dl-data dl))
		     (if (eq tmp-dl (dl-data dl)) (return)))
		 (progn (setf tmp-dl dl)
			(setf dl (dl-prev dl))))
	    tmp-dl)
	  nil)))
(defun dl-data-merge(dl1 dl2)
  (if (dl-p (dl-data dl1))
      (progn (setf elt (make-dl :prev dl1 :data dl2 :next (dl-data dl1)))
	     (setf (dl-prev (dl-data dl1)) elt)
	     (setf (dl-data dl1) elt)
	     dl1)
      (progn (setf elt (make-dl :prev (dl-prev dl1) :data dl2 :next dl1))
	     (if (dl-p (dl-prev dl1))
		  (setf (dl-next (dl-prev dl1)) elt))
	     (setf (dl-prev dl1) elt)
	     elt)))
		   
	   